home *** CD-ROM | disk | FTP | other *** search
/ Acorn User: China / Acorn User China CD-ROM (UK) (Disc A) / Acorn User China CD-ROM (UK) (Disc A).bin / HENSA / MATHS / PGPLOT.ARC / Examples_f77_PGDEMO16 < prev    next >
Encoding:
Text File  |  1997-05-13  |  11.7 KB  |  345 lines
  1.       PROGRAM PGDE16
  2. C
  3. C Demonstration program for bar charts (subroutine PGBCHT).
  4. C This subroutine may be included in the PGPLOT library in a future
  5. C release of PGPLOT
  6. C
  7.       INTEGER PGOPEN
  8.       INTEGER NCAT, NSET
  9.       PARAMETER (NCAT=5, NSET=2)
  10.       REAL VALS(NCAT, NSET)
  11.       REAL VALS2(NCAT, 3)
  12.       REAL VALS3(12)
  13.       CHARACTER*12 LABS(NCAT), LABS3(12)
  14.       REAL VMIN, VMAX
  15.       DATA VALS /15, 2, 3, 45, 17,
  16.      :           14, 1, 2, 44, 16/
  17.       DATA VALS2/15, -20, -13, 45, 17,
  18.      :           14, -11,  -8, 44, 16,
  19.      :           12,   9, -10, 30, 12/
  20.       DATA LABS /'Antelope', 'Bear', 'Cat', 'Dog', 'Elephant'/
  21.       DATA VALS3/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/
  22.       DATA LABS3/'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
  23.      :           'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'/
  24. C
  25. C Bar charts in PGPLOT
  26. C
  27.       IF (PGOPEN('?').LT.1) STOP
  28.       CALL PGSUBP(2,2)
  29.  
  30.       VMIN = 0.0
  31.       VMAX = 0.0
  32.       CALL PGPAGE
  33.       CALL PGVSTD
  34.       CALL PGBCHT(NCAT, 1, VALS, LABS, VMIN, VMAX, ' ', 0.7, 2)
  35.       CALL PGLAB(' ', ' ', 'Bar Chart')
  36.  
  37.       CALL PGPAGE
  38.       CALL PGBCHT(NCAT, 2, VALS, LABS, VMIN, VMAX, 'GN', 0.7, 2)
  39.       CALL PGLAB(' ', ' ', 'Grouped Bar Chart (no box)')
  40.  
  41.       CALL PGPAGE
  42.       CALL PGBCHT(NCAT, 2, VALS, LABS, VMIN, VMAX, 'GS', 0.7, 11)
  43.       CALL PGLAB(' ', ' ', 'Stacked Bar Chart')
  44.  
  45.       CALL PGPAGE
  46.       CALL PGBCHT(NCAT, 3, VALS2, LABS, VMIN, VMAX, 'G', 0.8, 5)
  47.       CALL PGLAB(' ', ' ', 'Grouped Bar Chart with Negative Values')
  48.       
  49.       CALL PGPAGE
  50.       CALL PGBCHT(NCAT, 3, VALS2, LABS, VMIN, VMAX, 'GS', 0.7, 5)
  51.       CALL PGLAB(' ', ' ', 'Stacked Bar Chart with Negative Values')
  52.       
  53.       CALL PGPAGE
  54.       CALL PGVSTD
  55.       CALL PGBCHT(NCAT, 1, VALS, LABS, VMIN, VMAX, 'H', 0.7, 2)
  56.       CALL PGLAB(' ', ' ', 'Bar Chart')
  57.  
  58.       CALL PGPAGE
  59.       CALL PGBCHT(NCAT, 2, VALS, LABS, VMIN, VMAX, 'HG', 0.7, 2)
  60.       CALL PGLAB(' ', ' ', 'Grouped Bar Chart')
  61.  
  62.       CALL PGPAGE
  63.       CALL PGBCHT(NCAT, 2, VALS, LABS, VMIN, VMAX, 'HGS', 0.7, 11)
  64.       CALL PGLAB(' ', ' ', 'Stacked Bar Chart')
  65.  
  66.       CALL PGPAGE
  67.       CALL PGBCHT(NCAT, 3, VALS2, LABS, VMIN, VMAX, 'HG', 0.8, 5)
  68.       CALL PGLAB(' ', ' ', 'Grouped Bar Chart with Negative Values')
  69.       
  70.       CALL PGPAGE
  71.       CALL PGBCHT(NCAT, 3, VALS2, LABS, VMIN, VMAX, 'HGS', 0.7, 5)
  72.       CALL PGLAB(' ', ' ', 'Stacked Bar Chart with Negative Values')
  73.       
  74.       CALL PGPAGE
  75.       CALL PGBCHT(NCAT, 3, VALS2, LABS, VMIN, VMAX, 'HGSF', 0.7, 7)
  76.       CALL PGLAB(' ', ' ', 'Stacked Bar Chart (Hatched)')
  77.       
  78.       CALL PGPAGE
  79.       CALL PGBCHT(NCAT, 3, VALS2, LABS, VMIN, VMAX, 'GF', 0.7, -1)
  80.       CALL PGLAB(' ', ' ', 'Grouped Bar Chart (Hatched)')
  81.  
  82.       CALL PGPAGE
  83.       CALL PGBCHT(12, 1, VALS3, LABS3, VMIN, VMAX, 'GF', 0.9, -1)
  84.       CALL PGLAB(' ', ' ', 'Bar Chart (Hatched)')
  85.       
  86.       CALL PGPAGE
  87.       CALL PGBCHT(12, 1, VALS3, LABS3, VMIN, VMAX, 'G', 0.5, 12)
  88.       CALL PGLAB(' ', ' ', 'Bar Chart')
  89.       
  90.       CALL PGCLOS
  91.       END
  92.  
  93. C*PGBCHT -- draw a bar or column chart
  94. C+
  95.       SUBROUTINE PGBCHT(NCAT, NSET, VALS, LABS, VMIN, VMAX, OPT,
  96.      :                  WIDTH, CI)
  97.       INTEGER NCAT, NSET
  98.       REAL VALS(NCAT,NSET)
  99.       CHARACTER*(*) LABS(NCAT)
  100.       REAL VMIN, VMAX
  101.       CHARACTER*(*) OPT
  102.       REAL WIDTH
  103.       INTEGER CI
  104. C
  105. C Description to be written.
  106. C
  107. C Arguments:
  108. C  NCAT   (input)  : number of categories, and first dimension of VALS.
  109. C  NSET   (input)  : number of data sets (i.e., number of values to be
  110. C                    plotted for each category).
  111. C  VALS   (input)  : data values: a 2-D array (a 1-D array may be used
  112. C                    if NSET=1). Element VALS(I,J) gives the value in
  113. C                    the Jth data set for category I. The first
  114. C                    dimension of VALS must be equal to NCAT, and the
  115. C                    second should equal or exceed NSET (only the first
  116. C                    NSET elements are used).
  117. C  LABS   (input)  : character array, dimension at least NCAT, giving
  118. C                    names for the NCAT categories.
  119. C  VMIN   (input)  : lower limit for the value axis (i.e., the vertical
  120. C                    axis for a vertical column chart, or the
  121. C                    horizontal axis for a horizontal bar chart).
  122. C  VMAX   (input)  : upper limit for the value axis. If VMIN=VMAX=0.0,
  123. C                    the subroutine chooses limits automatically.
  124. C  OPT    (input)  : a character string containing a list of one-letter
  125. C                    options (in any order, and case-insensitive):
  126. C                     F : if present, the data sets are distinguished
  127. C                         using different hatching styles; colors
  128. C                         are also used unless CI=-1 (see below).
  129. C                     G : if present, grid lines are drawn at major
  130. C                         intervals of the value axis.
  131. C                     H : if present, the subroutine draws a horizontal
  132. C                         bar chart, with categories arranged from 
  133. C                         top to bottom; otherwise it draws a vertical
  134. C                         column chart, with categories arranged from
  135. C                         left to right.
  136. C                     L : if present, the value axis is labelled
  137. C                         logarithmically. The end point of the
  138. C                         bars is at value 1 (10**0) rather than zero.
  139. C                         This is unsatisfactory if negative values
  140. C                         are used.
  141. C                     N : if present, the box around the viewport
  142. C                         is omitted (but not the baseline).
  143. C                     S : if present, the subroutine draws a stacked
  144. C                         bar chart; otherwise it draws a grouped
  145. C                         bar chart (there is no difference between
  146. C                         these for a single data set, NSET=1).
  147. C  WIDTH  (input)  : the fraction of the maximum width available for
  148. C                    each category that is occupied by bars. If
  149. C                    WIDTH=1.0, bars from adjacent categories abut.
  150. C                    Recommended value: 0.7 to 0.8.
  151. C  CI     (input)  : a color index. If CI=-1, all bars are colored
  152. C                    using the current color index (i.e., color index
  153. C                    1 unless PGSCI has been called). If CI is 0 or
  154. C                    positive, bars for the first data set are colored
  155. C                    using this color index, and bars for subsequent
  156. C                    data sets are colored using CI+1, CI+2, etc.
  157. C                    (Axes and labels always use the current color
  158. C                    index.)
  159. C--
  160. C 27-Jan-97 [TJP]
  161. C-----------------------------------------------------------------------
  162.       INTEGER I, J, CCI
  163.       LOGICAL GRID, STACK, HORIZ, LOGAX, HATCH, NOBOX
  164. C      LOGICAL PGNOTO
  165.       REAL DMIN, DMAX, CMIN, CMAX, XMIN, XMAX, YMIN, YMAX
  166.       REAL W, MARG, BWID, V, V1, V2, YMINN, YMINP
  167.       CHARACTER L*1, NB*2
  168.       INTEGER FS(3)
  169.       DATA FS/1, 3, 4/
  170. C
  171. C Check and decode arguments.
  172. C
  173.       IF (NCAT.LT.1 .OR. NSET.LT.1) RETURN
  174.       W = WIDTH
  175.       IF (WIDTH.GT.1.0 .OR. WIDTH.LE.0.0) THEN
  176. C          CALL GRWARN('PGBCHT: WIDTH argument should be <= 1.0, > 0.0')
  177.           W = 1.0
  178.       END IF
  179. C      IF (PGNOTO('PGBCHT')) RETURN
  180.       GRID  = INDEX(OPT,'G').NE.0 .OR. INDEX(OPT,'g').NE.0
  181.       STACK = INDEX(OPT,'S').NE.0 .OR. INDEX(OPT,'s').NE.0
  182.       HORIZ = INDEX(OPT,'H').NE.0 .OR. INDEX(OPT,'h').NE.0
  183.       LOGAX = INDEX(OPT,'L').NE.0 .OR. INDEX(OPT,'l').NE.0
  184.       HATCH = INDEX(OPT,'F').NE.0 .OR. INDEX(OPT,'f').NE.0
  185.       NOBOX = INDEX(OPT,'N').NE.0 .OR. INDEX(OPT,'n').NE.0
  186. C
  187. C Determine the data range if necessary.
  188. C
  189.       DMIN = VMIN
  190.       DMAX = VMAX
  191.       IF (DMIN.EQ.0.0 .AND. DMAX.EQ.0.0) THEN
  192.          IF (.NOT.STACK) THEN
  193. C        -- Grouped bar chart
  194.             DO J=1,NSET
  195.                DO I=1,NCAT
  196.                   IF (VALS(I,J).GT.DMAX) DMAX = VALS(I,J)
  197.                   IF (VALS(I,J).LT.DMIN) DMIN = VALS(I,J)
  198.                END DO
  199.             END DO
  200.          ELSE
  201. C        -- Stacked bar chart
  202. C           (accumulate pos and neg separately)
  203.             DO I=1,NCAT
  204.                V1 = 0.0
  205.                V2 = 0.0
  206.                DO J=1,NSET
  207.                   IF (VALS(I,J).GT.0.0) V1 = V1+VALS(I,J)
  208.                   IF (VALS(I,J).LT.0.0) V2 = V2+VALS(I,J)
  209.                END DO
  210.                IF (V1.GT.DMAX) DMAX = V1
  211.                IF (V2.LT.DMIN) DMIN = V2
  212.             END DO
  213.          END IF
  214.          CALL PGRNGE(DMIN, DMAX, DMIN, DMAX)
  215.       END IF
  216.       CMIN = 0.0
  217.       CMAX = NCAT
  218. C
  219. C Set the window.
  220. C
  221.       CALL PGBBUF
  222.       IF (HORIZ) THEN
  223.          CALL PGSWIN(DMIN, DMAX, CMAX, CMIN)
  224.       ELSE
  225.          CALL PGSWIN(CMIN, CMAX, DMIN, DMAX)
  226.       END IF
  227. C
  228. C Draw a grid if requested.
  229. C
  230.       IF (GRID) THEN
  231.          CALL PGSAVE
  232.          CALL PGSCI(15)
  233.          CALL PGSLW(1)
  234.          CALL PGSLS(2)
  235.          IF (HORIZ) THEN
  236.             CALL PGBOX('G', 0.0, 0, ' ', 0.0, 0)
  237.          ELSE
  238.             CALL PGBOX(' ', 0.0, 0, 'G', 0.0, 0)
  239.          END IF
  240.          CALL PGUNSA
  241.       END IF
  242.       CALL PGSAVE
  243.       CALL PGQCI(CCI)
  244. C
  245. C Draw the bars.
  246. C
  247.       MARG = (1.0-W)*0.5
  248.       IF (.NOT.STACK) THEN
  249. C        -- Grouped bar chart
  250.          BWID = W/REAL(NSET)
  251.          DO I=1,NCAT
  252.             DO J=1,NSET
  253.                V = VALS(I,J)
  254.                IF (V.NE.0.0) THEN
  255.                   IF (CI.GE.0) CALL PGSCI(CI+J-1)
  256.                   CALL PGSFS(1)
  257.                   IF (HATCH) CALL PGSFS(FS(1+MOD(J,3)))
  258.                   XMIN = (I-1)+MARG+(J-1)*BWID
  259.                   XMAX = XMIN+BWID
  260.                   YMIN = 0.0
  261.                   YMAX = V
  262.                   IF (HORIZ) THEN
  263.                      CALL PGRECT(YMIN, YMAX, XMIN, XMAX)
  264.                   ELSE
  265.                      CALL PGRECT(XMIN, XMAX, YMIN, YMAX)
  266.                   END IF
  267.                   CALL PGSCI(CCI)
  268.                   CALL PGSFS(2)
  269.                   IF (HORIZ) THEN
  270.                      CALL PGRECT(YMIN, YMAX, XMIN, XMAX)
  271.                   ELSE
  272.                      CALL PGRECT(XMIN, XMAX, YMIN, YMAX)
  273.                   END IF
  274.                END IF
  275.             END DO
  276.          END DO
  277.       ELSE
  278. C        -- Stacked bar chart
  279.          DO I=1,NCAT
  280.             YMINP = 0.0
  281.             YMINN = 0.0
  282.             DO J=1,NSET
  283.                V = VALS(I,J)
  284.                IF (V.NE.0.0) THEN
  285.                   IF (CI.GE.0) CALL PGSCI(CI+J-1)
  286.                   CALL PGSFS(1)
  287.                   IF (HATCH) CALL PGSFS(FS(1+MOD(J,3)))
  288.                   XMIN = (I-1)+MARG
  289.                   XMAX = XMIN+W
  290.                   IF (V.LT.0.0) THEN
  291.                      YMIN = YMINN
  292.                      YMINN = YMINN+V
  293.                   ELSE
  294.                      YMIN = YMINP
  295.                      YMINP = YMINP+V
  296.                   END IF
  297.                   YMAX = YMIN+V
  298.                   IF (HORIZ) THEN
  299.                      CALL PGRECT(YMIN, YMAX, XMIN, XMAX)
  300.                   ELSE
  301.                      CALL PGRECT(XMIN, XMAX, YMIN, YMAX)
  302.                   END IF
  303.                   CALL PGSCI(CCI)
  304.                   CALL PGSFS(2)
  305.                   IF (HORIZ) THEN
  306.                      CALL PGRECT(YMIN, YMAX, XMIN, XMAX)
  307.                   ELSE
  308.                      CALL PGRECT(XMIN, XMAX, YMIN, YMAX)
  309.                   END IF
  310.                END IF
  311.             END DO
  312.          END DO
  313.       END IF
  314. C
  315. C Draw the axes, and a baseline if necessary.
  316. C
  317.       CALL PGSCI(CCI)
  318.       L = ' '
  319.       IF (LOGAX) L= 'L'
  320.       NB = 'BC'
  321.       IF (NOBOX) NB = '  '
  322.       IF (HORIZ) THEN
  323.          CALL PGBOX('NST'//NB//L, 0.0, 0, 'ATP'//NB, 1.0, 1)
  324.       ELSE
  325.          CALL PGBOX('ATP'//NB, 1.0, 1, 'NSTV'//L//NB, 0.0, 0)
  326.       END IF
  327. C
  328. C Label the categories.
  329. C
  330.       CALL PGUPDT
  331.       DO I=1,NCAT
  332.          IF (HORIZ) THEN
  333.             CALL PGMTXT('LV', 0.5, 1.0-(I-0.5)/REAL(NCAT), 1.0, LABS(I))
  334.          ELSE
  335.             CALL PGMTXT('B', 1.2, (I-0.5)/REAL(NCAT), 0.5, LABS(I))
  336.          END IF
  337.       END DO
  338. C
  339. C Done.
  340. C
  341.       CALL PGUNSA
  342.       CALL PGEBUF
  343.       RETURN
  344.       END
  345.